Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/KEYBOARD.PAS

Pascal/Delphi Source File | 1997-03-02 | 6KB | 217 lines

UNIT Keyboard;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ KeyPressed and ReadKey routines               Last changed: 02.03.97  SA ║}
{║                                                                          ║}
{║                         (C) Copyright 1989-97 by                         ║}
{║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
{║                                                                          ║}
{║ This source may not be given to anybody, without the written permission  ║}
{║ from The Portal Team.                                                    ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}

INTERFACE

USES Use32, OpKey;

CONST
  HelpKey    : Word = F1;
  InMainMenu : Boolean = False;

TYPE
  KbdStatType = PROCEDURE(KbdFlag: Byte);

PROCEDURE SetKbdStatProc(p: KbdStatType) ;
PROCEDURE NoKbdStatProc(KbdFlag: Byte) ;
FUNCTION  PopKeyPressed: Boolean;
FUNCTION  PopReadKeyWord: Word;
PROCEDURE StartClock;
PROCEDURE StopClock;

IMPLEMENTATION

USES Dos, OpDos, OpCrt, OpDate, OpWindow, OpString, OpCal, OpCalc, OpQkRef,
     ApTimer,
     MTask, ScrBlank, DosShell, LogFile, MemStat, InterCom, PoPTypes,
     Globals, Util,
{$IFNDEF OS2}
     Macro,
{$ELSE}
     VpUtils,
{$ENDIF}
     PoPHelp;

VAR
  NewKbdFlags,
  OldKbdFlags : Byte;
  KbdStatProc : KbdStatType;
  Clock       : LongInt;

  PROCEDURE SetKbdStatProc(p: KbdStatType) ;
  BEGIN
    KbdStatProc:=p;
    NewKbdFlags:=0;
    OldKbdFlags:=1;
  END;

  PROCEDURE NoKbdStatProc(KbdFlag: Byte) ;
  BEGIN
  END;

  FUNCTION PopKeyPressed: Boolean;
  BEGIN
    IF KbdFlags<>BlankKbdFlags THEN TurnScreen(On);
    NewKbdFlags:=KbdFlags AND $0f;
    IF NewKbdFlags<>OldKbdFlags THEN
    BEGIN
      KbdStatProc(NewKbdFlags);
      OldKbdFlags:=NewKbdFlags;
    END;
    IF KeyPressed THEN
    BEGIN
      KbdStatProc(0);
      PopKeyPressed:=True;
    END ELSE
    BEGIN
{     Inline($cd/$28); = int $28 }
      WITH StatusWindow^, Cfg.Color[1] DO
      BEGIN
{$IFDEF OS2}
        IF (Clock<>-1) AND (((GetTimemSec-Clock)>=1000) OR (GetTimemSec<Clock)) THEN
{$ELSE}
        IF (Clock<>-1) AND (((BiosTics^-Clock)>=18) OR (BiosTics^<Clock)) THEN
{$ENDIF}
        BEGIN
          IF ScreenBlanked THEN
            MoveClock
          ELSE
          BEGIN
            ActivateWrite;
            wFastWrite(TodayString('dd/mm-yy'),1,11,HighLightColor);
            wFastWrite(CurrentTimeString('hh:mm:ss'),2,11,HighlightColor);
            DeActivateWrite;
          END;
          StartClock;
        END;
      END;
      GiveUpTime;
      PopKeyPressed:=KeyPressed;
    END;
  END;

  FUNCTION PopReadKeyWord: Word;
  VAR
    w : Word;
    i : LongInt;
    OldPrompt      : String;
    Env            : EnvRec;
    TmpAdr         : TFidoAddress;
    Cal            : CalendarPtr;
    Calc           : CalculatorPtr;
    QkRef          : QkRefChartPtr;
  BEGIN
    w:=0;
    REPEAT
      REPEAT
        GiveUpTime;
      UNTIL PopKeyPressed;
      TurnScreen(On);
      w:=ReadKeyWord;
      IF KeyboardLock THEN
      BEGIN
        IF Chr(Lo(w)) = data.KbdPassword[Length(TmpPassword) + 1] THEN TmpPassword:=TmpPassword + Chr(Lo(w)) ELSE
          TmpPassword:='';
        IF TmpPassword = data.KbdPassword THEN
        BEGIN
          data.KbdPassword:='';
          KeyboardLock:=False;
          AddLog(' ', 'Keyboard unlocked');
{$IFNDEF OS2}
          WriteMacroStatus;
{$ENDIF}
        END;
        w:=1;
      END ELSE
      BEGIN
        CASE w OF
          $e00d: w:=Enter;
          AltG : MemoryStatus;
          AltJ : BEGIN
                   FillChar(TmpAdr, SizeOf(TmpAdr), 0);
                   IF SetInterCom(ICDosShell,TmpAdr,False) THEN
                   BEGIN
                     AddLog(':', 'Shelling to OS');
                     CurrentEnv(Env);
                     OldPrompt:=GetEnvStr(Env, 'PROMPT=');
                     SetEnvStr(Env, 'PROMPT=', '[Portal of Power v' + Ver + ' Shell]$_' + OldPrompt);
                     i:=ShellToDos(GetEnv('COMSPEC'), '',True);
                     SetEnvStr(Env, 'PROMPT=', OldPrompt);
                     IF i=0 THEN
                       AddLog(':', 'Portal of Power Reactivated')
                     ELSE
                       AddLog('!', 'Error '+Long2Str(i)+' when shelling to OS');
                   END;
                 END;
{$IFNDEF OS2}
          AltK : IF NOT InMainMenu THEN
                 BEGIN
                   i:=0;
                   MacroMenu(i);
                 END;
{$ENDIF}
{$IFNDEF PoPLite}
          Alt1 : BEGIN
                   New(Cal, InitCustom(25+((ScreenWidth-80) DIV 2), 10, DefLeftTee, DefCrossBar, DefRightTee,
                                       Cfg.Color[4], DefWindowOptions));
                   IF  Cal<>Nil THEN
                   BEGIN
                     Cal^.ProcessSelf;
                     Dispose(Cal, Done);
                   END;
                 END;
          Alt2 : BEGIN
                   New(Calc, InitCustom(20+((ScreenWidth-80) DIV 2), 10, DefLeftTee, DefCrossBar, DefRightTee,
                                        Cfg.Color[4], DefWindowOptions));
                   IF  Calc<>Nil THEN
                   BEGIN
                     Calc^.ProcessSelf;
                     Dispose(Calc, Done);
                   END;
                 END;
          Alt3 : BEGIN
                   New(QkRef, InitCustom(2, 3, ScreenWidth-1, ScreenHeight-1, DefLeftTee,
                                         DefCrossBar, DefRightTee, Cfg.Color[4], DefWindowOptions));
                   IF  QkRef<>Nil THEN
                   BEGIN
                     QkRef^.ProcessSelf;
                     Dispose(QkRef, Done);
                   END;
                 END;
{$ENDIF}
          ELSE   IF (w=HelpKey) AND (Topic<>0) THEN HelpRoutine(0, Nil, Topic);
        END;
      END;
    UNTIL w<>0;
    NewTimerSecs(ScreenBlank, Cfg.Screen.BlankTime);
    PopReadKeyWord:=w;
  END;

  PROCEDURE StartClock;
  BEGIN
{$IFDEF OS2}
    Clock:=GetTimemSec;
{$ELSE}
    Clock:=BiosTics^;
{$ENDIF}
  END;

  PROCEDURE StopClock;
  BEGIN
    Clock:=-1;
  END;

BEGIN
  OldKbdFlags:=0;
  KbdStatProc:=NoKbdStatProc;
END.